subroutine bandchar(dosym,lmax,ikloc,evecfv,evecsv,ld,bndchr)
use modmain
implicit none
! arguments
logical, intent(in) :: dosym
integer, intent(in) :: lmax
integer, intent(in) :: ikloc
complex(8), intent(in) :: evecfv(nmatmax,nstfv,nspnfv)
complex(8), intent(in) :: evecsv(nstsv,nstsv)
integer, intent(in) :: ld
real(4), intent(out) :: bndchr(ld,natmtot,nspinor,nstsv)
! local variables
integer ispn,ias,io1,io2,lm
integer l,m,lm1
integer j,isym,lspl,nsym1
complex(8), allocatable :: wfsvmt(:,:,:,:,:)
complex(8), allocatable :: apwalm(:,:,:,:)
! automatic arrays
complex(8) zt1(ld,nufrmax),zt2(ld),zt3
integer ik

ik=mpi_grid_map(nkpt,dim_k,loc=ikloc)
allocate(wfsvmt(ld,nufrmax,natmtot,nspinor,nstsv))
allocate(apwalm(ngkmax,apwordmax,lmmaxapw,natmtot))

call match(ngk(1,ik),gkc(1,1,ikloc),tpgkc(1,1,1,ikloc),sfacgk(1,1,1,ikloc),apwalm)
call genwfsvmt(lmax,ld,ngk(1,ik),evecfv(:,:,1),evecsv,apwalm,wfsvmt)

if (dosym) then
  nsym1=nsymcrys
else
  nsym1=1
endif

bndchr=0.d0
do j=1,nstfv
  do ispn=1,nspinor
    do ias=1,natmtot
      if (dosym) then
        nsym1=nsymsite(ias)
      else
        nsym1=1
      endif
      do isym=1,nsym1
        lspl=lsplsyms(isym,ias)
        zt1=dcmplx(0.d0,0.d0)
        do io1=1,nufrmax
          call rotzflm(symlatc(1,1,lspl),3,1,ld,wfsvmt(1:ld,io1,ias,ispn,j+(ispn-1)*nstfv),zt2)
          do lm=1,ld
            do lm1=1,ld
              zt1(lm,io1)=zt1(lm,io1)+yrlm_lps(lm1,lm,ias)*zt2(lm1)
            enddo
          enddo
        enddo !io1
        do l=0,lmax
          do m=-l,l
            lm=idxlm(l,m)
            do io1=1,nufrmax
              do io2=1,nufrmax
                bndchr(lm,ias,ispn,j+(ispn-1)*nstfv)=bndchr(lm,ias,ispn,j+(ispn-1)*nstfv) + &
                  ufrp(l,io1,io2,ias2ic(ias))*dreal(dconjg(zt1(lm,io1))*zt1(lm,io2))/nsym1
              enddo
            enddo
! not tested: partial contribution from APW (io2=1) or lo (io2=2)
!            zt3=zzero
!            do io1=1,nrfmax
!              zt3=zt3+dconjg(zt1(lm,io1))*urfprod(l,io1,2,ias)/nsym1
!	        enddo
!	        bndchr(lm,ias,ispn,j+(ispn-1)*nstfv)=abs(zt3)**2
          enddo !m
        enddo !l
      enddo !isym    
    enddo
  enddo
enddo

deallocate(wfsvmt,apwalm)
return
end subroutine
!EOC
